home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyTermination.p < prev    next >
Text File  |  1996-05-20  |  998b  |  61 lines
  1. unit MyTermination;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.     
  8.     type
  9.         TermProcType = procedure;
  10.         
  11.     procedure InitTermination(term:TermProcType);
  12.     procedure FinishTermination;
  13.     
  14. implementation
  15.  
  16.     uses
  17.         Traps,MyCallProc,MyUtils,PreserveA5;
  18.  
  19.     var
  20.         gTermination:TermProcType;
  21.         gExitToShell:UniversalProcPtr;
  22.         
  23.     procedure CallTermination;
  24.         var
  25.             tmp:TermProcType;
  26.     begin
  27.         if gTermination<>nil then begin
  28.             tmp:=gTermination;
  29.             gTermination:=nil;
  30.             tmp();
  31.         end;
  32.     end;
  33.     
  34.     procedure ExitToShellPatch;
  35.         var
  36.             olda5:Ptr;
  37.             lExitToShell:UniversalProcPtr;
  38.     begin
  39.         olda5:=SetPreservedA5;
  40.         CallTermination;
  41.         lExitToShell:=gExitToShell;
  42.         RestoreA5(olda5);
  43.         CallPascal0(lExitToShell);
  44.     end;
  45.  
  46.     procedure InitTermination(term:TermProcType);
  47.     begin
  48.         gTermination:=term;
  49.         if term<>nil then begin
  50.             gExitToShell:=MyGetTrapAddress(_ExitToShell);
  51.             MySetTrapAddress(NewProc(@ExitToShellPatch,uppPascal0ProcInfo),_ExitToShell);
  52.         end;
  53.     end;
  54.     
  55.     procedure FinishTermination;
  56.     begin
  57.         CallTermination;
  58.     end;
  59.     
  60. end.
  61.